Transit-Oriented Development (TOD) is a strategy for designing cities and neighborhoods around transit systems to enhance access, reduce dependence on automobiles, and improve environmental and economic outcomes. This analysis focuses on Washington D.C., investigating demographic patterns within transit-rich areas and evaluating how these patterns have changed from 2012 to 2022 using census data. Understanding these changes is crucial for urban planners to ensure equitable access to transit, promote sustainable growth, and address issues like gentrification, displacement, and environmental justice.
This report uses data from the American Community Survey (ACS) and Washington Metropolitan Area Transit Authority (WMATA) to explore the demographic makeup within a half-mile radius of D.C. metro stations. It visualizes racial and income distributions to analyze potential disparities in access to transit and measure the progress of TOD policies over time.
We begin by loading packages, loading our API key etc.,
There are a few new wrinkles here - we use the source
command to bring in customized functions from our text book, we set some
options for scientific notation (scipen), and
some options for tigris data to be imported in
sf form (you might find that useful in your assignment). We
also specify a 5 color palette called palette5 - you might
want to make your own for your work if you like different colors.
# Load Libraries
library(tidyverse)
library(tidycensus)
library(sf)
library(kableExtra)
options(scipen=999)
options(tigris_class = "sf")
source("https://raw.githubusercontent.com/urbanSpatial/Public-Policy-Analytics-Landing/master/functions.r")
palette5 <- c("#f0f9e8","#bae4bc","#7bccc4","#43a2ca","#0868ac")
census_api_key("53071f0c2548de0961c66471e808c51402d4f06e", overwrite = TRUE)
get_acs() to get 2012 ACS dataNotice this returns “long” data - let’s examine it using
glimpse.
What’s this CRS? Check out spatialreference.com and look it up!
ggplot() +
geom_sf(data = dctracts12 %>%
filter(variable == "B02001_001"),
aes(fill = q5(estimate))) +
scale_fill_manual(values = palette5,
labels = qBr(dctracts12 %>%
filter(variable == "B02001_001"), "estimate"),
name = "Population in housing\n(Quintile Breaks)") +
labs(title = "Total Population", subtitle = "Washington D.C.; 2012") +
mapTheme() +
theme(plot.title = element_text(size=22))
ggplot() +
geom_sf(data = dctracts22 %>%
filter(variable == "B02001_001"),
aes(fill = q5(estimate))) +
scale_fill_manual(values = palette5,
labels = qBr(dctracts12 %>%
filter(variable == "B02001_001"), "estimate"),
name = "Population in housing\n(Quintile Breaks)") +
labs(title = "Total Population", subtitle = "Washington D.C.; 2022") +
mapTheme() +
theme(plot.title = element_text(size=22))
dctract12.adj =
get_acs(geography = "tract",
variables = acs_varlist,
year=2012, state=11,
geometry=TRUE) %>%
st_transform('EPSG:2248') %>%
dplyr::select(-NAME, -moe) %>%
spread(key = variable, value = estimate) %>%
rename(totPop = B02001_001,
totWhite = B02001_002,
totBlack = B02001_003,
totAsian = B02001_005,
totLatinx = B03001_003,
medHHIncome = B19013_001,
medRent = B25058_001,
totPoverty = B06012_002) %>%
mutate(pctWhite = ifelse(totPop > 0, totWhite / totPop, 0),
pctBlack = ifelse(totPop > 0, totBlack / totPop, 0),
pctAsian = ifelse(totPop > 0, totAsian / totPop, 0),
pctLatinx = ifelse(totPop > 0, totLatinx / totPop, 0),
pctPoverty = ifelse(totPop > 0, totPoverty / totPop, 0),
year = "2012") %>%
dplyr::select(-totWhite,-totBlack,-totAsian,-totLatinx,-totPoverty)
dc_transit = st_read("https://maps2.dcgis.dc.gov/dcgis/rest/services/DCGIS_DATA/Transportation_Rail_Bus_WebMercator/MapServer/51/query?outFields=*&where=1%3D1&f=geojson") %>%
st_transform("EPSG:2248")
## Reading layer `OGRGeoJSON' from data source
## `https://maps2.dcgis.dc.gov/dcgis/rest/services/DCGIS_DATA/Transportation_Rail_Bus_WebMercator/MapServer/51/query?outFields=*&where=1%3D1&f=geojson'
## using driver `GeoJSON'
## Simple feature collection with 98 features and 14 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: -77.49154 ymin: 38.76653 xmax: -76.84455 ymax: 39.11994
## Geodetic CRS: WGS 84
dctract22.adj =
get_acs(geography = "tract",
variables = acs_varlist,
year=2022, state=11,
geometry=TRUE) %>%
st_transform('EPSG:2248') %>%
dplyr::select( -NAME, -moe) %>%
spread(key = variable, value = estimate) %>%
rename(totPop = B02001_001,
totWhite = B02001_002,
totBlack = B02001_003,
totAsian = B02001_005,
totLatinx = B03001_003,
medHHIncome = B19013_001,
medRent = B25058_001,
totPoverty = B06012_002) %>%
mutate(pctWhite = ifelse(totPop > 0, totWhite / totPop, 0),
pctBlack = ifelse(totPop > 0, totBlack / totPop, 0),
pctAsian = ifelse(totPop > 0, totAsian / totPop, 0),
pctLatinx = ifelse(totPop > 0, totLatinx / totPop, 0),
pctPoverty = ifelse(totPop > 0, totPoverty / totPop , 0),
year = "2022") %>%
dplyr::select(-totWhite,-totBlack,-totAsian,-totLatinx,-totPoverty)
## | | | 0% | |== | 2% | |=========================== | 39% | |======================================================================| 100%
ggplot() +
geom_sf(data=st_union(dctract12.adj), fill= "grey", color = "white", size = 2) +
geom_sf(data=dc_transit, color = "black", size= 1.5) +
labs(title = " Metro Stations Rapid Transit Stops",
caption = "Data: WMATA 2024")+
theme_minimal() +
theme(plot.title = element_text(size = 12, face = "bold"))
### Filtering metro stations only within D.C.
dc_station = st_intersection(dc_transit, dctract12.adj)
transitbuffer = st_buffer(dc_station, 2640) %>% st_sf()
bufferunion = st_union(transitbuffer)
dcBuffers =
rbind(
transitbuffer %>%
mutate(Legend = "Buffer") %>%
dplyr::select(Legend),
bufferunion %>%
st_sf() %>%
mutate(Legend = "Unioned Buffer")
)
dcBufferUnion <- filter(dcBuffers, Legend == "Unioned Buffer")
ggplot() +
geom_sf(data = st_union(dctract12.adj), fill = "grey", color = "white", size = 2) +
geom_sf(data = dc_station, fill = "white", color = "black") +
ggtitle("Metro Stations Within D.C.") +
theme(
plot.title = element_text(size = 12, face = "bold"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
panel.background = element_blank()
)
allTracts = rbind(dctract12.adj, dctract22.adj)
allTracts.adj =
rbind(
st_centroid(allTracts)[bufferunion,] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "TOD"),
st_centroid(allTracts)[bufferunion, op = st_disjoint] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "Not TOD")) %>%
mutate(medRent.adj = ifelse(year == "2012", medRent * 1.27, medRent)) %>%
mutate(medHHIncome.adj = ifelse(year == "2012", medHHIncome * 1.27, medHHIncome))
This code serves to isolate the Metro stations located within D.C. and to visualize the areas around these stations where transit-oriented development (TOD) policies might be impactful, using buffer zones to highlight proximity.
ggplot() +
geom_sf(data=st_union(dctract12.adj), fill= "grey", color = "white", size = 2) +
geom_sf(data=dc_station, color = "black", size= 1.0) +
geom_sf(data=bufferunion, fill = 'transparent', color = 'blue', linewidth = 0.5) +
labs(title = "D.C. Metro Stations Rapid Transit Stops",
caption = "Data: WMATA 2024")+
theme(plot.title = element_text(size = 12, face = "bold"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
panel.background = element_blank())
Within the study area nearby metro stations, we will analyze data for both 2012 and 2022 for changes and pattern within these areas. The percentage of each ethnic groups living within the tract is the first indicator that we consider in this analysis.
allTracts.adj %>%
ggplot()+
geom_sf(aes(fill=pctWhite), color="grey") +
scale_fill_continuous(low = "white", high = "#225ea8", name= "Percentage White Population")+
facet_wrap(~year) +
geom_sf(data=bufferunion, color = "black", fill = "transparent", linewidth = 0.5) +
theme(legend.position = "top",
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
plot.title = element_text(size = 12, face = "bold"),
panel.background = element_blank(),
panel.border = element_rect(colour = "white", fill=NA, size=0.8)
) +
labs(title = "Percentage of White Population per tract \nwithin Washington, D.C.",
caption = "0.5 mile buffer of transit stops represented via blue circles. \n \n Data from American Community Survey 2012 and 2022 \n and WMATA 2024")
In 2012, the spatial distribution of the white population in Washington, D.C. shows a clear concentration in the western and northwestern parts of the city, where the percentage of white residents was the highest, often above 75%. These areas, shaded in dark blue, reveal a significant presence of white residents, particularly in neighborhoods far from central transit hubs. However, when examining the research areas (the 0.5-mile buffer zones around transit stops), we observe that while some of these areas, especially in the west, also show higher percentages of white residents, the central and southeastern research areas near transit stops are characterized by much lower percentages. These neighborhoods exhibit lighter shades of blue, indicating a more diverse population with fewer white residents.
By 2022, the map indicates notable demographic shifts. While the northwest region continues to have high percentages of white residents, more central and eastern parts of D.C. show a marked increase in the white population. The research areas near transit stops, particularly in the central and eastern neighborhoods, have seen a significant rise in white residents, with many areas transitioning from light to darker shades of blue over the decade. This change suggests that these neighborhoods, previously more diverse or predominantly non-white, have experienced a demographic shift that aligns with gentrification trends often associated with urban renewal and increased access to transit-oriented development. In contrast, areas that already had high white populations in 2012 seem to have remained relatively stable in demographic composition.
Overall, the maps show that the expansion of the white population into central and eastern D.C. has been influenced by proximity to transit stops. The research areas around these transit stops appear to have attracted more white residents over time, contributing to gentrification patterns that are common in many urban settings. As neighborhoods close to transit become more desirable, the demographic makeup shifts, often resulting in an increase in white residents. This trend reflects broader changes in urban population dynamics, where accessibility to public transportation, housing affordability, and urban development policies interact to reshape neighborhood demographics.
allTracts.adj %>%
ggplot()+
geom_sf(aes(fill=pctBlack), color="grey") +
scale_fill_continuous(low = "white", high = "#225ea8", name= "Percentage Black Population")+
facet_wrap(~year) +
geom_sf(data=bufferunion, color = "black", fill = "transparent", linewidth = 0.5) +
theme(legend.position = "top",
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
plot.title = element_text(size = 12, face = "bold"),
panel.background = element_blank(),
panel.border = element_rect(colour = "white", fill=NA, size=0.8)
) +
labs(title = "Percentage of Black Population per tract \nwithin Washington, D.C.",
caption = "0.5 mile buffer of transit stops represented via blue circles. \n \n Data from American Community Survey 2012 and 2022 \n and WMATA 2024")
The maps display the percentage of the Black population by tract in Washington, D.C., for 2012 and 2022, with the research areas (0.5-mile buffers around transit stops) highlighted. In 2012, the spatial distribution shows a high concentration of Black residents in the southeastern and eastern parts of the city, with darker blue shades indicating over 75% Black population in these areas. Within the research areas, particularly in the central and southeastern regions, there are also relatively high percentages of Black residents, contrasting with the northwestern tracts where the Black population is much lower.
By 2022, there is a noticeable decline in the percentage of the Black population in central D.C., as the shades in those tracts have lightened compared to 2012. While the eastern and southeastern regions remain predominantly Black, the research areas in central D.C. have seen a shift, with the Black population decreasing in some tracts near transit stops. The pattern suggests that the demographic changes around the research areas have led to a more diverse population, particularly in central neighborhoods.
These maps highlight demographic shifts over time, with a decrease in the percentage of Black residents in central D.C., especially near transit stops. The research areas seem to be experiencing gentrification, with an influx of other populations replacing or reducing the Black population in certain neighborhoods. This change mirrors broader urban trends where transit-rich areas become more desirable, leading to shifts in the racial and demographic makeup of the community.
allTracts.adj %>%
ggplot()+
geom_sf(aes(fill=pctAsian), color="grey") +
scale_fill_continuous(low = "white", high = "#225ea8", name= "Percentage Asian Population")+
facet_wrap(~year) +
geom_sf(data=bufferunion, color = "black", fill = "transparent", linewidth = 0.5) +
theme(legend.position = "top",
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
plot.title = element_text(size = 12, face = "bold"),
panel.background = element_blank(),
panel.border = element_rect(colour = "white", fill=NA, size=0.8)
) +
labs(title = "Percentage of Asian Population per tract \nwithin Washington, D.C.",
caption = "0.5 mile buffer of transit stops represented via blue circles. \n \n Data from American Community Survey 2012 and 2022 \n and WMATA 2024")
allTracts.adj %>%
ggplot()+
geom_sf(aes(fill=pctLatinx), color="grey") +
scale_fill_continuous(low = "white", high = "#225ea8", name= "Percentage Latinx Population")+
facet_wrap(~year) +
geom_sf(data=bufferunion, color = "black", fill = "transparent", linewidth = 0.5) +
theme(legend.position = "top",
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
plot.title = element_text(size = 12, face = "bold", family = 'sans'),
panel.background = element_blank(),
panel.border = element_rect(colour = "white", fill=NA, size=0.8)
) +
labs(title = "Percentage of Latinx Population per tract \nwithin Washington, D.C.",
caption = "0.5 mile buffer of transit stops represented via blue circles. \n \n Data from American Community Survey 2012 and 2022 \n and WMATA 2024")
In 2012, the Latinx population was concentrated in central and northern
areas near transit stops, with some tracts showing over 30%. By 2022,
this concentration decreased, becoming more dispersed across the study
area, suggesting demographic shifts or gentrification effects.
The following part mainly analyze the relationship of median household income within the research area. This code chunk generates a comparative map of median household income for Washington, D.C., in 2012 and 2022, focusing on the relationship within the research area (0.5-mile buffer of transit stops).
allTracts.adj %>%
ggplot()+
geom_sf(aes(fill=medHHIncome.adj), color="grey") +
scale_fill_continuous(low = "white", high = "#3182bd", name= "Median Household Income ($)")+
facet_wrap(~year) +
geom_sf(data=bufferunion, color = "black", fill = "transparent", linewidth = 0.5) +
theme(legend.position = "top",
plot.title = element_text(size = 12, face = "bold"),
panel.background = element_blank(),
panel.border = element_rect(colour = "white", fill=NA, size=0.8),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
) +
labs(title = "Median Household Income per tract \nwithin Washington, D.C.",
caption = "0.5 mile buffer of transit stops represented via blue circles. \n \n Data from American Community Survey 2012 and 2022 \n and WMATA 2024")
In 2012, tracts with higher percentages of the Black population tend to have lower median household incomes, particularly in the southeastern parts of Washington, D.C., as indicated by the gray shading in those areas on the income map. Conversely, areas with higher percentages of the White population, especially in the northwest, align with higher median household incomes. This pattern persists into 2022, where areas that have seen an increase in the White population within the research areas—typically closer to central D.C.—also exhibit rising median household incomes.
The maps of the Asian and Latinx populations show some variation, but neither has as strong of a correlation with median household income as the White and Black population percentages. The tracts with higher concentrations of Asian and Latinx residents do not show as significant a shift in income patterns, particularly within the research areas.
Overall, the percentage of the White and Black populations seems to have the strongest impact on median household income within the research areas. The rising presence of White residents in transit-adjacent neighborhoods correlates with higher income levels, while the decline of Black residents in these same areas accompanies this shift. This indicates that gentrification and demographic changes are key drivers of household income dynamics near transit stops.
allTracts.adj %>%
ggplot()+
geom_sf(aes(fill=pctPoverty), color="grey") +
scale_fill_continuous(low = "white", high = "#3182bd", name= "Percentage of people under poverty")+
facet_wrap(~year) +
geom_sf(data=bufferunion, color = "black", fill = "transparent", linewidth = 0.5) +
theme(legend.position = "top",
plot.title = element_text(size = 12, face = "bold"),
panel.background = element_blank(),
panel.border = element_rect(colour = "white", fill=NA, size=0.8),
axis.text.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
) +
labs(title = "Percentage of people under poverty per tract \nwithin Washington, D.C.",
caption = "0.5 mile buffer of transit stops represented via blue circles. \n \n Data from American Community Survey 2012 and 2022 \n and WMATA 2024")
The maps show significant changes in median household income between 2012 and 2022 within the study area, which includes neighborhoods near transit stops in Washington, D.C. In 2012, much of the study area had lower median household incomes, particularly in the central and southeastern tracts, shown in gray. These areas had incomes below $100,000. The highest-income areas, shaded in blue, were mostly in the northwest, far from the central transit stops.
By 2022, the map shows an increase in median incomes, especially in central and eastern tracts near transit. Areas that were gray in 2012 now show lighter or darker blue, indicating rising incomes. The northwest remains high-income, but the most noticeable changes are closer to the city center.
Overall, there has been a substantial rise in median household income within the study area over 10 years, particularly in neighborhoods closer to transit hubs. This shift suggests gentrification and economic growth in these areas. ## Summary Table
allTracts.Summary =
st_drop_geometry(allTracts.adj) %>%
group_by(year, TOD) %>%
summarize(
Income = mean(medHHIncome.adj, na.rm = T),
PctPoverty = mean(pctPoverty, na.rm = T),
Population = mean(totPop, na.rm = T),
PctWhite = mean(pctWhite, na.rm = T),
PctBlack = mean(pctBlack, na.rm = T),
PctAsian = mean(pctAsian, na.rm = T),
PctLatinx = mean(pctLatinx, na.rm = T))
kable(allTracts.Summary) %>%
kable_styling()
| year | TOD | Income | PctPoverty | Population | PctWhite | PctBlack | PctAsian | PctLatinx |
|---|---|---|---|---|---|---|---|---|
| 2012 | Not TOD | 81821.82 | 0.1960039 | 3299.561 | 0.2812141 | 0.6339622 | 0.0231934 | 0.0690661 |
| 2012 | TOD | 94844.07 | 0.1591645 | 3509.806 | 0.4590497 | 0.4385741 | 0.0448032 | 0.1029521 |
| 2022 | Not TOD | 110887.24 | 0.1466668 | 3314.295 | 0.3350739 | 0.5182407 | 0.0304658 | 0.1035872 |
| 2022 | TOD | 118959.27 | 0.1397790 | 3184.957 | 0.5113966 | 0.3150597 | 0.0581227 | 0.1181532 |
allTracts.Summary %>%
gather(Variable, Value, -year, -TOD) %>%
ggplot(aes(year, Value, fill = TOD)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~Variable, scales = "free", ncol=5) +
scale_fill_manual(values = c("#349beb", "#09e06d")) +
labs(title = "Indicator Differences Across Time and Space",
caption = "Data: American Community Survey 2012 and 2022") +
theme(legend.position = "bottom",
axis.ticks.x=element_blank(),
axis.ticks.y=element_blank(),
plot.title = element_text(size = 12, face = "bold"),
panel.background = element_blank(),
panel.border = element_rect(colour = "grey", fill=NA, size=0.8))
The bar plots compare demographic and economic indicators for Transit-Oriented Development (TOD) and Non-TOD areas in 2012 and 2022. TOD areas saw significant increases in median household income and rent, along with a rise in the percentage of White, Asian, and Latinx residents, while the percentage of Black residents decreased. In contrast, Non-TOD areas experienced more stable demographic changes, with smaller shifts in income and rent. Overall, TOD areas show signs of gentrification, with rising housing costs and shifts in racial composition, particularly an increase in higher-income households.
mrb = multipleRingBuffer(st_union(dc_station), 14484, 804)
ggplot() +
geom_sf(data=mrb, aes(fill = distance), color = "#708090", alpha = 0.5) +
scale_fill_continuous(low = "#FAF9F6", high = "#595fff", name= "Distance")+
geom_sf(data=st_union(dctract12.adj), fill= "transparent", color = "black", size = 2) +
geom_sf(data=dc_station, color = "#fd7f6f", size= 0.8) +
labs(title="Half Mile Buffers",
subtitle = "Distance in-between each buffer is 0.5 mile",
caption = "Data from American Community Survey 2012 and 2022 \nand WMATA 2024") +
theme(plot.title = element_text(size = 12, face = "bold"),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.text.y=element_blank(),
axis.ticks.y=element_blank(),
panel.background = element_blank(),
plot.subtitle = element_text(size = 9,face = "italic"))
### Join Median Income and Distance Data
incomeDist = st_join(mrb, allTracts.adj, join = st_intersects) %>%
group_by(distance, year) %>%
summarize(median_income = mean(medHHIncome, na.rm = TRUE))
## `summarise()` has grouped output by 'distance'. You can override using the
## `.groups` argument.
ggplot(incomeDist, aes(x = distance, y = median_income)) +
geom_line(aes(linetype = year, color = year), linewidth = 3) +
labs(title = "Median Income as a Function of Distance to Transit Stations in D.C.",
x = "Distance from D.C. Transit Stations",
y = "Median Income",
caption = "Data from American Community Survey 2012 and 2022 \nand WMATA 2024") +
theme_minimal()
## Conclusion
In conclusion, this analysis of Transit-Oriented Development (TOD) in Washington D.C. from 2012 to 2022 highlights significant demographic and economic shifts in neighborhoods near metro stations. The findings suggest that proximity to transit has become a major factor in shaping the population distribution, particularly in terms of racial and income demographics.
The white population has expanded into central and eastern D.C. areas, which previously had higher concentrations of Black and Latinx residents, signaling gentrification trends. These changes have also been accompanied by rising median household incomes, particularly in TOD neighborhoods, further supporting the idea that transit access is driving economic transformation and urban renewal. The increasing desirability of these areas for higher-income households underscores the importance of addressing issues like displacement and equitable access to transit.
Overall, the demographic shifts and income growth patterns observed in this study suggest that while TOD policies may foster economic growth and increased transit use, they also risk contributing to socioeconomic inequality. This highlights the need for careful urban planning to ensure that TOD promotes inclusive development and benefits all residents equitably.